-- Aufgabenblatt 6

import Data.Char
import Data.List

data Nat = Z | S Nat

-- benchmark purpose
main = do
  putStrLn . show $ map romShow [1..100000]

romShow :: Integer -> String
romShow i
  | i == 0      = []
  | i > 1000    = toChar 1000 : romShow (i - 1000)
  | i < 4*l     = toChar l : romShow (i - l)
  | i < m       = toChar (d m) : toChar m : romShow (i - m + (d m))
  | i < m + 4*l = toChar m : romShow (i - m)
  | otherwise   = toChar (d u) : toChar u : romShow (i - u + (d u))
  where
    m = l * 5

    d x
      | i >= x - 1    = 1
      | i >= x - 10   = 10
      | i >= x - 100  = 100
      | i >= x - 1000 = 1000

    l | i < 10    = 1
      | i < 100   = 10
      | otherwise = 100

    u = 10 * l

    toChar 1    = 'I'
    toChar 5    = 'V'
    toChar 10   = 'X'
    toChar 50   = 'L'
    toChar 100  = 'C'
    toChar 500  = 'D'
    toChar 1000 = 'M'


natToInteger Z = 0
natToInteger (S n) = 1 + natToInteger n

integerToNat 0 = Z
integerToNat i = S (integerToNat (i - 1))

instance Show Nat where

  show = romShow . natToInteger

--------------------------------------------------------------------------------
--------------------------------------------------------------------------------

data RatNumbers = Rat Numerator Denominator
type Numerator = Nat
type Denominator = Nat

class Nf a where
  t2nf :: a -> a

negaBinaryToDecimal :: String -> Integer
negaBinaryToDecimal nb = sum $ zipWith (*) coeffs negBinPowers
   where
     l = length nb
     negBinPowers = [(-2)^i | i <- [(l-1),(l-2)..0]]
     coeffs = map (\x -> toInteger $ (ord x) - (ord '0')) nb

decimalToNegaBinary' :: Integer -> String
decimalToNegaBinary' n
   | n == 0 = []
   | r < 0  = decimalToNegaBinary' (q+1) ++ show (r+2)
   | r >= 0 = decimalToNegaBinary' q ++ show r
   where
     r = n `mod` (-2)
     q = n `div` (-2)

decimalToNegaBinary :: Integer -> String
decimalToNegaBinary n
  | n == 0 = "0"
  | otherwise = decimalToNegaBinary' n

mkCoPrime (n,m)
  | g == 1 = (n,m)
  | otherwise = (n `div` g, m `div` g)
  where
    g = gcd n m

rnToReal (Rat n d) = natToInteger n / natToInteger d

instance Show RatNumbers where

  show (Rat n d) = (f n) ++ "/" ++ (f d)
    where
      f = decimalToNegaBinary . natToInteger

instance Nf RatNumbers where

  t2nf (Rat n d) = Rat (integerToNat k) (integerToNat l)
    where
      (k,l) = mkCoPrime (natToInteger n, natToInteger d)

instance Eq RatNumbers where

  (==) rn1 rn2 = (rnToReal rn1) == (rnToReal rn2)

instance Ord RatNumbers where

  (<=) rn1 rn2 = (rnToReal rn1) <= (rnToReal rn2)

instance Num RatNumbers where

  (+) (Rat n1 d1) (Rat n2 d2) = t2nf (Rat n d)
    where
      n1' = natToInteger n1
      d1' = natToInteger d1
      n2' = natToInteger n2
      d2' = natToInteger d2

      n = integerToNat $ n1'*d2' + n2'*d1'
      d = integerToNat $ d1'*d2'

  (-) (Rat n1 d1) (Rat n2 d2) = t2nf (Rat n d)
    where
      n1' = natToInteger n1
      d1' = natToInteger d1
      n2' = natToInteger n2
      d2' = natToInteger d2

      n = integerToNat $ n1'*d2' - n2'*d1'
      d = integerToNat $ d1'*d2'

  (*) (Rat n1 d1) (Rat n2 d2) = t2nf (Rat n d)
    where
      n1' = natToInteger n1
      d1' = natToInteger d1
      n2' = natToInteger n2
      d2' = natToInteger d2

      n = integerToNat $ n1'*n2'
      d = integerToNat $ d1'*d2'


  fromInteger i = Rat (integerToNat i) (S Z)

  abs r = r

  signum (Rat Z _) = Rat Z (S Z)
  signum _ = Rat (S Z) (S Z)

--------------------------------------------------------------------------------
--------------------------------------------------------------------------------

newtype NatP = NP (Nat,Nat) deriving Show

mkNatCan (NP (Z,n)) = NP (Z,n)
mkNatCan (NP (S (n), m)) = NP (n,S(m))

instance Nf NatP where

  t2nf (NP (Z,m)) = NP (Z,m)
  t2nf (NP (n,Z)) = NP (n,Z)
  t2nf (NP (S n,S m)) = t2nf $ NP (n,m)

--------------------------------------------------------------------------------
--------------------------------------------------------------------------------
